home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / rts / population.scm < prev    next >
Text File  |  1995-10-13  |  893b  |  38 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4.  
  5.  
  6. (define (make-population)
  7.   (list '<population>))
  8.  
  9. (define (add-to-population! x pop)
  10.   (if (not x) (error "can't put #f in a population"))
  11.   (if (not (weak-memq x (cdr pop)))
  12.       (set-cdr! pop (cons (make-weak-pointer x) (cdr pop)))))
  13.  
  14. (define (weak-memq x weaks)
  15.   (if (null? weaks)
  16.       #f
  17.       (if (eq? x (weak-pointer-ref (car weaks)))
  18.       weaks
  19.       (weak-memq x (cdr weaks)))))
  20.  
  21. (define (population-reduce cons nil pop)
  22.   (do ((l (cdr pop) (cdr l))
  23.        (prev pop l)
  24.        (m nil (let ((w (weak-pointer-ref (car l))))
  25.         (if w
  26.             (cons w m)
  27.             (begin (set-cdr! prev (cdr l))
  28.                m)))))
  29.       ((null? l) m)))
  30.  
  31. (define (population->list pop)
  32.   (population-reduce cons '() pop))
  33.  
  34. (define (walk-population proc pop)
  35.   (population-reduce (lambda (thing junk) (proc thing))
  36.              #f
  37.              pop))
  38.